home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / doors_1 / fd200.zip / FD_FILES.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-04-07  |  2.6 KB  |  110 lines
  1. function parse_int(src_str: msg_str): integer;
  2. var i,err : integer;
  3. begin
  4.   while (src_str[1] = ' ') AND (length(src_str) > 0)
  5.     do  src_str := copy(src_str,2,length(src_str)-1);
  6.   val(src_str,i,err);
  7.   parse_int := i;
  8. end;
  9.  
  10. procedure parse_line(var source   : any_string; var fd_p : LINK);
  11. begin
  12. end;
  13.  
  14. procedure read_file;
  15. var  filename : file_type;
  16.      dummy : msg_str;
  17.      point,i,error : integer;
  18.      fd_file : text[$800];
  19.      p : LINK;
  20. begin
  21.   window(32,8,79,16);
  22.   get_file_name(filename,1,1,default_file,32,8,79,16);
  23.   if (filename = '') then filename := default_file;
  24.   default_file := filename;
  25.   assign(fd_file,filename);
  26.   {$I-}
  27.   reset(fd_file);
  28.   if (IOresult <> 0)
  29.   then
  30.     begin
  31.       ClrScr;
  32.       writeln('File not found');
  33.       writeln;
  34.       write('Press any key to continue..');
  35.       wait_for_key;
  36.       ClrScr;
  37.     end
  38.   else
  39.     begin
  40.       writeln;
  41.       while (NOT Eof(fd_file)) do
  42.       begin
  43.         readln(fd_file,dummy);
  44.         p := talloc;
  45.         if (p <> NIL) then parse_line(dummy,p);
  46.       end;
  47.     end;
  48.   close(fd_file);
  49. end;
  50.  
  51. procedure write_file;
  52. var  filename, backup, testname : file_type;
  53.      dummy : msg_str;
  54.      point,i : integer;
  55.      key, old_area : char;
  56.      fd_file, test_file, old_file : text[$1000];
  57.      copy_line : string[80];
  58.      todays_date : DateStr;
  59. begin
  60.   todays_date := date;
  61.   window(32,8,79,16);
  62.   ClrScr;
  63.   get_file_name(filename,1,1,default_file,32,8,79,16);
  64.   if (filename = '') then filename := default_file;
  65.   testname := filename;
  66.   assign(test_file,testname);
  67.   {$I-}
  68.   reset(test_file);
  69.   if (IOresult = 0)
  70.   then
  71.     begin
  72.       point := pos('.',testname);
  73.       if point = 0 then backup := testname + '.BAK'
  74.                    else backup := copy(testname,1,point-1) + '.BAK';
  75.       writeln; writeln('Creating backup file: ',backup);
  76.       assign(old_file,backup);
  77.       {$I-}
  78.       rewrite(old_file);
  79.       while NOT Eof(test_file) do
  80.       begin
  81.         readln(test_file,copy_line);
  82.         writeln(old_file,copy_line);
  83.       end;
  84.       close(test_file);
  85.       close(old_file);
  86.     end
  87.   else
  88.     close(test_file);
  89.   assign(fd_file,filename);
  90.   rewrite(fd_file);
  91.   i := IOresult;
  92.   if (i <> 0)
  93.   then
  94.     begin
  95.       writeln; writeln('Unable to open file ',filename,' - ',i);
  96.       write('Press any key to continue ...');
  97.       wait_for_key;
  98.       close(fd_file);
  99.     end
  100.   else
  101.     begin
  102.       writeln; write('Writing records ...');
  103.       fprint(root);
  104.       close(fd_file);
  105.     end;
  106.   ClrScr;
  107.   window(1,1,80,25);
  108. end;
  109.  
  110.